home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Business Assistant
/
Business Assistant.iso
/
indus
/
rental
/
tenant.prg
< prev
Wrap
Text File
|
1986-05-30
|
17KB
|
540 lines
* Last revision: May 26, 1986 at 11:43
* tenant.prg main command program of tenant database
STOR .t. TO first
* set up the loop
STOR .T. to more
DO WHIL more
* if first time this trip
IF first
DO t_first
STOR .f. TO first
ENDI
STOR '<B>ackward, <D>elete/Recall, <E>dit, <F>orward, <H>elp, <P>rint' TO prompt1
STOR '<S>earch by code number, search a<N>y part of database' TO prompt2
STOR 'b<u>ilding records or <R>eturn to main Menu SELECT: ' TO prompt3
STOR 'Main Tenant Database ' TO mode
STOR '?' TO command
* find out if the current record is marked for deletion
IF DELETE()
STOR 'Deleted' TO deleted
ELSE
STOR ' ' TO deleted
ENDI *
STOR trent TO trentx
IF ttype = 'P'
IF (trentpc*(trentpcr/100)/12)>trent
STOR (trentpc*(trentpcr/100)/12) TO trentx
ENDI (trentpc)
ENDI ttype = 'P'
IF ttype = 'O'
STOR ((trentpc*(trentpcr/100)/12)+trent) TO trentx
ENDI ttype = 'O'
STOR (trentx + taddl + trente + trentm) TO trentxx
* show the current record, and find out what to do next
@ 0, 0 SAY deleted
@ 1,26 SAY mode
@ 3,10 SAY tenant
@ 3,62 SAY bcode
@ 4,10 SAY tunit
@ 4,36 SAY baddr
@ 5,10 SAY tcontac
@ 5,62 SAY tphone
@ 6,36 SAY alt
@ 7,10 SAY altad
@ 8,10 SAY altcty
@ 10,10 SAY ttype
@ 10,36 SAY trentpc PICTURE '99.9999'
@ 10,62 SAY tfirst
@ 11,10 SAY trentpcr PICTURE '999,999,999'
@ 11,62 SAY texpir
@ 12,10 SAY tsec PICTURE '99,999.99'
@ 12,36 SAY tsecb
@ 12,62 SAY tlate
@ 13,10 SAY trent PICTURE '99,999.99'
@ 13,36 SAY tlatec PICTURE '99,999.99'
@ 13,62 SAY taddl PICTURE '99,999.99'
@ 14,10 SAY trente PICTURE '99,999.99'
@ 14,36 SAY trentm PICTURE '99,999.99'
@ 14,62 SAY trentxx PICTURE '99,999.99'
@ 15,10 SAY trentd PICTURE '99,999.99'
@ 15,36 SAY trentpd PICTURE '99/99/99'
@ 15,62 SAY trentp PICTURE '99,999.99'
@ 16,10 SAY trenty PICTURE '99,999.99'
@ 16,36 SAY tflag
@ 16,62 SAY trentt PICTURE '99,999.99'
@ 18,10 SAY tnotes
@ 18,61 SAY tupdate
@ 20, 7 SAY prompt1
@ 21, 7 SAY prompt2
@ 22, 7 SAY prompt3
@ 22,70 GET command PICTURE '!'
READ
* perform selected function
DO CASE
CASE (command = 'B' .OR. command = ',' )
* move backwards one record
SKIP -1
LOOP
CASE command = 'D'
* switch the current record from deleted to recalled
IF DELETE()
RECA
ELSE
DELE
ENDI DELETE()
LOOP
CASE command = 'E'
SET DELIMITER OFF
SET INTENSITY ON
* store field variables into mem variables for editing
STOR tenant TO mtenant
STOR bcode TO mbcode
STOR tunit TO mtunit
STOR baddr TO mbaddr
STOR tcontac TO mtcontac
STOR tphone TO mtphone
STOR alt TO malt
STOR altad TO maltad
STOR altcty TO maltcty
STOR ttype TO mttype
STOR trentpc TO mtrentpc
STOR texpir TO mtexpir
STOR trentpcr TO mtrenpcr
STOR tfirst TO mtfirst
STOR tsec TO mtsec
STOR tsecb TO mtsecb
STOR tlate TO mtlate
STOR trent TO mtrent
STOR taddl TO mtaddl
STOR trente TO mtrente
STOR trentm TO mtrentm
STOR trentp TO mtrentp
STOR trentpd TO mtrentpd
STOR tlatec TO mtlatec
STOR trentd TO mtrentd
STOR trenty TO mtrenty
STOR trentt TO mtrentt
STOR tflag TO mtflag
STOR tnotes TO mtnotes
STOR tupdate TO mtupdate
* set up screen and prompt for editing
STOR 'Edit Tenant Data ' TO mode
STOR ' Enter the new or corrected information ' TO prompt1
STOR " Control 'Q'or 'W' to end edit session " TO prompt2
STOR SPACE(70) TO prompt3
@ 1,26 SAY mode
@ 3,10 GET mtenant
@ 3,62 GET mbcode PICTURE '99999'
@ 4,10 GET mtunit
@ 4,36 GET mbaddr
@ 5,10 GET mtcontac
@ 5,62 GET mtphone PICTURE '(999)999-9999'
@ 6,36 GET malt PICTURE '!'
@ 7,10 GET maltad
@ 8,10 GET maltcty
@ 10,10 GET mttype PICTURE '!'
@ 10,36 GET mtrentpc
@ 10,62 GET mtfirst PICTURE '99/99/99'
@ 11,10 SAY SPACE(16)
@ 11,10 GET mtrenpcr
@ 11,62 GET mtexpir PICTURE '99/99/99'
@ 12,10 GET mtsec
@ 12,36 GET mtsecb
@ 12,62 GET mtlate PICTURE '99'
@ 13,10 GET mtrent
@ 13,36 GET mtlatec
@ 13,62 GET mtaddl
@ 14,10 GET mtrente
@ 14,36 GET mtrentm
@ 15,10 GET mtrentd
@ 15,36 GET mtrentpd PICTURE '99/99/99'
@ 15,62 GET mtrentp
@ 16,10 GET mtrenty
@ 16,36 GET mtflag PICTURE '99/99/99'
@ 16,62 GET mtrentt
@ 18,10 GET mtnotes
@ 18,61 GET mtupdate PICTURE '99/99/99'
@ 20,07 SAY prompt1
@ 21,07 SAY prompt2
@ 22,07 SAY prompt3
READ
CLEA GETS
* test if there is a bad field validation
DO CASE
CASE mbcode = ' '
STOR .t. TO error
CASE .NOT.(malt = 'Y' .OR. malt = 'N')
STOR .t. TO error
CASE .NOT.(mttype = 'R'.OR.mttype='P'.OR. mttype='O')
STOR .t. TO error
CASE (mttype = 'P'.OR. mttype = 'O') .AND.(.NOT.(mtrentpc >0.AND. mtrenpcr >0))
STOR .t. TO error
OTHE
STOR .f. TO error
ENDC
* if test for error was true then fix the fields that need fixing
IF error
* erase the lines to be used for prompts
@ 01,00
@ 20,00
@ 21,00
@ 22,00
* tell them to correct it
@ 1,18 SAY 'Please Correct the Indicated Data'
* keep looping until all fields are fixed
STOR .t. to an_error
DO WHIL an_error
DO CASE
CASE mbcode = ' '
@ 20,01 SAY SPACE(75)
@ 21,01 SAY SPACE(75)
@ 20,15 SAY 'Must have a tenant code '
@ 03,62 GET mbcode PICTURE '99999'
READ
CASE .NOT.(malt = 'Y' .OR. malt = 'N')
@ 20,01 SAY SPACE(75)
@ 21,01 SAY SPACE(75)
@ 20,15 SAY "Must answer 'Y' or 'N' to alternate address"
@ 06,36 GET malt PICTURE '!'
READ
CASE .NOT.(mttype = 'R'.OR.mttype='P'.OR. mttype='O')
@ 20,01 SAY SPACE(75)
@ 21,01 SAY SPACE(75)
@ 20,05 SAY "Type must be 'R' for Regular, 'P' for Percentage which uses the higher of"
@ 21,05 SAY "the percentage or the base rent or 'O' for Overage plus base rent"
@ 10,10 GET mttype PICTURE '!'
READ
CASE (mttype = 'P'.OR. mttype = 'O').AND.(.NOT.(mtrentpc>0.AND. mtrenpcr> 0))
@ 20,01 SAY SPACE(75)
@ 21,01 SAY SPACE(75)
@ 20,05 SAY 'If a percentage or overage lease, you must state the percentage'
@ 21,05 SAY 'AND the base for calculating the percentage rent'
@ 10,36 GET mtrentpc
@ 11,10 GET mtrenpcr
READ
OTHE
STOR .f. TO an_error
ENDC
ENDD while an:error
ENDI error
STOR 'N' TO command
SET DELIMITER ON
SET INTENSITY OFF
@ 20,01 SAY SPACE(75)
@ 21,01 SAY SPACE(75)
@ 20,23 SAY 'Are there any more changes ? '
@ 20,50 GET command picture '!'
READ
SET INTENSITY ON
SET DELIMITER OFF
IF command = 'Y'
@ 1,00
@ 1,26 SAY mode
@ 3,10 GET mtenant
@ 3,62 GET mbcode PICTURE '99999'
@ 4,10 GET mtunit
@ 4,36 GET mbaddr
@ 5,10 GET mtcontac
@ 5,62 GET mtphone PICTURE '(999)999-9999'
@ 6,36 GET malt PICTURE '!'
@ 7,10 GET maltad
@ 8,10 GET maltcty
@ 10,10 GET mttype PICTURE '!'
@ 10,36 GET mtrentpc
@ 10,62 GET mtfirst PICTURE '99/99/99'
@ 11,10 GET mtrenpcr
@ 11,62 GET mtexpir PICTURE '99/99/99'
@ 12,10 GET mtsec
@ 12,36 GET mtsecb
@ 12,62 GET mtlate PICTURE '99'
@ 13,10 GET mtrent
@ 13,36 GET mtlatec
@ 13,62 GET mtaddl
@ 14,10 GET mtrente
@ 14,36 GET mtrentm
@ 15,10 GET mtrentd
@ 15,36 GET mtrentpd PICTURE '99/99/99'
@ 15,62 GET mtrentp
@ 16,10 GET mtrenty
@ 16,36 GET mtflag PICTURE '99/99/99'
@ 16,62 GET mtrentt
@ 18,10 GET mtnotes
@ 18,61 GET mtupdate PICTURE '99/99/99'
@ 20,01 SAY SPACE(75)
@ 21,01 SAY SPACE(75)
@ 22,01 SAY SPACE(75)
@ 20,07 SAY prompt1
@ 21,07 SAY prompt2
@ 22,07 SAY prompt3
* let user enter data
READ
CLEA GETS
ENDI command = 'Y'
REPL tenant WITH mtenant, bcode WITH mbcode, tunit WITH mtunit
REPL baddr WITH mbaddr, tcontac WITH mtcontac, tphone WITH mtphone
REPL alt WITH malt, altad WITH maltad, altcty WITH maltcty
REPL ttype WITH mttype, texpir WITH mtexpir
REPL trentpc WITH mtrentpc, trentpcr WITH mtrenpcr
REPL tfirst WITH mtfirst, tsec WITH mtsec, tsecb WITH mtsecb
REPL t